home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / mouse.swg / 0025_Gfx mouse in textmode?.pas < prev   
Pascal/Delphi Source File  |  1994-11-30  |  5KB  |  179 lines

  1. {
  2.  JK> Could anybody send me a routine that uses graphical mouse pointer
  3.  JK> in 80x25 textmode? I don't want a block cursor which moves from
  4.  JK> character to another (it's not very accurate). I would need a
  5.  JK> arrow pointer which can be moved softly around the screen.
  6.  
  7. It aint perfect - it's a little shocky - but it works, and might give you a
  8. clue on how to operate. A credit would be in place. ;-)
  9.  
  10. Check this:
  11.  
  12. >--- cut here
  13. }
  14. program txtmouse;
  15. { Graphics mouse cursor in textmode, by Bas van Gaalen,
  16.   fido 2:285/213.8, internet bas.van.gaalen@schotman.nl, Holland, PD }
  17. uses
  18.   crt;
  19. const
  20.   setimg=0; getimg=1;
  21.   vidseg:word=$b800;
  22.   mscursor:array[0..7] of byte=(252,248,248,248,252,142,7,3);
  23. type
  24.   worktype=array[0..3,0..7] of byte;
  25. var
  26.   pdata:array[0..3] of byte;
  27.   px,py:byte;
  28.  
  29. { mouse routines ----------------------------------------------------------- }
  30.  
  31. function mouseinstalled:boolean; assembler; asm
  32.   xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;
  33.  
  34. function getmousex:word; assembler; asm
  35.   mov ax,3; int 33h; mov ax,cx end;
  36.  
  37. function getmousey:word; assembler; asm
  38.   mov ax,3; int 33h; mov ax,dx end;
  39.  
  40. function leftpressed:boolean; assembler; asm
  41.   mov ax,3; int 33h; and bx,1; mov ax,bx end;
  42.  
  43. function rightpressed:boolean; assembler; asm
  44.   mov ax,3; int 33h; and bx,2; mov ax,bx end;
  45.  
  46. procedure mousesensetivity(x,y:word); assembler; asm
  47.   mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;
  48.  
  49. procedure mousewindow(l,t,r,b:word); assembler; asm
  50.   mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8
  51.   mov cx,t; mov dx,b; int 33h end;
  52.  
  53. function hardx:byte; begin hardx:=getmousex div 8; end;
  54. function hardy:byte; begin hardy:=getmousey div 8; end;
  55. function smoothx:word; begin smoothx:=getmousex mod 8; end;
  56. function smoothy:word; begin smoothy:=getmousey mod 8; end;
  57.  
  58. { -------------------------------------------------------------------------- }
  59.  
  60. procedure getsetimage(chr:byte; var data; getset:byte); assembler;
  61. asm
  62.   push ds
  63.   mov al,32
  64.   mul [chr]
  65.   cmp getset,getimg
  66.   je @goget
  67.   mov di,ax
  68.   mov ax,0a000h
  69.   mov es,ax
  70.   mov cx,8/2
  71.   lds si,data
  72.   jmp @start
  73.  @goget:
  74.   mov si,ax
  75.   mov ax,0a000h
  76.   mov ds,ax
  77.   mov cx,8/2
  78.   les di,data
  79.  @start:
  80.   cli
  81.   mov dx,03c4h; mov ax,0402h; out dx,ax; mov ax,0704h; out dx,ax
  82.   mov dx,03ceh; mov ax,0204h; out dx,ax; mov ax,0005h; out dx,ax; 
  83.   mov ax,0006h; out dx,ax
  84.   rep movsw
  85.   mov dx,03c4h; mov ax,0302h; out dx,ax; mov ax,0304h; out dx,ax
  86.   mov dx,03ceh; mov ax,0004h; out dx,ax; mov ax,1005h; out dx,ax; 
  87.   mov ax,0e06h; out dx,ax
  88.   sti
  89.   pop ds
  90. end;
  91.  
  92. { -------------------------------------------------------------------------- }
  93.  
  94. procedure retrace; assembler; asm
  95.   mov dx,03dah
  96.   @vert1: in al,dx; test al,8; jnz @vert1
  97.   @vert2: in al,dx; test al,8; jz @vert2
  98. end;
  99.  
  100. { save old characters to screen }
  101. procedure saveold;
  102. begin
  103.   pdata[0]:=mem[vidseg:py*160+px*2];
  104.   pdata[1]:=mem[vidseg:py*160+(px+1)*2];
  105.   pdata[2]:=mem[vidseg:(py+1)*160+px*2];
  106.   pdata[3]:=mem[vidseg:(py+1)*160+(px+1)*2];
  107. end;
  108.  
  109. { restore old characters to screen }
  110. procedure restoreold;
  111. begin
  112.   mem[vidseg:py*160+px*2]:=pdata[0];
  113.   mem[vidseg:py*160+(px+1)*2]:=pdata[1];
  114.   mem[vidseg:(py+1)*160+px*2]:=pdata[2];
  115.   mem[vidseg:(py+1)*160+(px+1)*2]:=pdata[3];
  116. end;
  117.  
  118. { clear 'data' }
  119. procedure cleardata(var data:worktype); begin
  120.   fillchar(data,sizeof(data),0); end;
  121.  
  122. { get chars from screen and put font-data in 'data' }
  123. procedure getscrdata(var data:worktype);
  124. var ch,i,j,x,y:byte;
  125. begin
  126.   x:=hardx; y:=hardy;
  127.   getsetimage(mem[vidseg:y*160+x*2],data[0],getimg);
  128.   getsetimage(mem[vidseg:y*160+(x+1)*2],data[1],getimg);
  129.   getsetimage(mem[vidseg:(y+1)*160+x*2],data[2],getimg);
  130.   getsetimage(mem[vidseg:(y+1)*160+(x+1)*2],data[3],getimg);
  131. end;
  132.  
  133. { add info-font-data and mouse-arrow together }
  134. procedure addata(var data:worktype);
  135. var i:byte;
  136. begin
  137.   for i:=0 to 7-smoothy do data[0,i+smoothy]:=data[0,i+smoothy] or (mscursor[i]
  138. shr smoothx);  for i:=0 to 7-smoothy do data[1,i+smoothy]:=data[1,i+smoothy] or
  139. (mscursor[i] shl (8-smoothx));  for i:=0 to smoothy do data[2,i]:=data[2,i] or
  140. (mscursor[8-smoothy+i] shr smoothx);  for i:=0 to smoothy do
  141. data[3,i]:=data[3,i] or (mscursor[8-smoothy+i] shl (8-smoothx));end;
  142.  
  143. { place graphicsmouse on textscreen }
  144. procedure placemouse(data:worktype);
  145. var i,x,y:byte;
  146. begin
  147.   for i:=0 to 3 do getsetimage(219+i,data[i],setimg);
  148.   x:=hardx; y:=hardy; px:=x; py:=y; saveold;
  149.   mem[vidseg:py*160+px*2]:=219;
  150.   mem[vidseg:py*160+(px+1)*2]:=220;
  151.   mem[vidseg:(py+1)*160+px*2]:=221;
  152.   mem[vidseg:(py+1)*160+(px+1)*2]:=222;
  153. end;
  154.  
  155. { -------------------------------------------------------------------------- }
  156.  
  157. var
  158.   ms:worktype;
  159.   i,j,x,y:byte;
  160. begin
  161.   textmode(co80+font8x8);
  162.   mem[$40:$49]:=6; { fool mouse to be in graphics-mode (needed for smooth) }
  163.   if not mouseinstalled then begin writeln('need mouse.'); halt; end;
  164.   mousesensetivity(20,20);
  165.   mousewindow(0,0,639-8,399-8);
  166.   for i:=10 to 69 do for j:=0 to 35 do memw[vidseg:4*160+j*160+i+i]:=((j*20+i)
  167. mod 255)+7*256;  px:=hardx; py:=hardy; saveold;
  168.   while not leftpressed do begin
  169.     write(#13,hardx:2,',',hardy:2);
  170.     retrace;
  171.     restoreold;
  172.     cleardata(ms);
  173.     getscrdata(ms);
  174.     addata(ms);
  175.     placemouse(ms);
  176.   end;
  177.   textmode(lastmode);
  178. end.
  179.